home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / der12.zip / DERDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  5KB  |  157 lines
  1. {$B-,D-,T-,I-,L-,S-,V-}
  2. {$M 16384,0,655360 }
  3.  
  4. Program DERDemo;
  5.  
  6. Uses
  7.   Crt, Qwik, WndwVars, Wndw, DER;
  8.  
  9. Type
  10.   Str15 = String[15];
  11.   Str20 = String[20];
  12.   Date  = Word;
  13.  
  14.   Test_Record = Record
  15.                  TString     : Str20;
  16.                  TDate       : Date;
  17.                  TTime       : Time;
  18.                  TPhone      : Phone;
  19.                  TWord       : Word;
  20.                  TInteger    : Integer;
  21.                  TByte       : Byte;
  22.                  TReal       : Real;
  23.                  TSex        : Byte;
  24.                  TYesNo      : Byte;
  25.                  T1a         : Byte;
  26.                  T1b         : Byte;
  27.                  TSSN        : SSN;
  28.                End;
  29.  
  30. Var
  31.   Test_Info  : Test_Record;
  32.   ExtKey     : Boolean;
  33.   JulDef     : Word;
  34.   DefaultDate : Date;
  35.  
  36. {$I DERDEMO.WND}
  37.  
  38. Function DisplayQuestion(Var Test_Info: Test_Record;Which:Integer):Char;
  39. Const
  40.   Up   : CharSet = [CursorUp];
  41.   Down : CharSet = [CursorDown,Return];
  42.   Next : CharSet = [Escape,PageDown,PageUp];
  43. Var
  44.   TC : Char;
  45.   LL : Byte;
  46.   I  : Byte;
  47. Begin
  48.   With Test_Info Do
  49.   Begin
  50.     Case Which of
  51.       1: Begin
  52.            QWrite( 5,17,NormalAtt,TimeToString(TTime));
  53.            QWrite( 7,17,NormalAtt,WordToString(TWord));
  54.            QWrite( 9,17,NormalAtt,ByteToString(TByte));
  55.            QWrite(11,17,NormalAtt,BooleanToString(TSex,'M','F'));
  56.            QWrite(13,33,NormalAtt,SSNToString(TSSN));
  57.  
  58.            QWrite( 3,58,NormalAtt,DateToStr(TDate));
  59.            QWrite( 5,58,NormalAtt,PhoneToString(TPhone));
  60.            QWrite( 7,58,NormalAtt,IntegerToString(TInteger));
  61.            QWrite( 9,58,NormalAtt,RealToString(TReal));
  62.            QWrite(11,58,NormalAtt,BooleanToString(TYesNo,'Y','N'));
  63.  
  64.            LL := 1;
  65.            Repeat
  66.              Case LL Of
  67.                1: TC := SelectString(TString,20,17,3);
  68.                2: TC := SelectTime(TTime,17,5);
  69.                3: TC := SelectWord(TWord,0,65000,5,17,7);
  70.                4: TC := SelectByte(TByte,0,255,3,17,9);
  71.                5: TC := SelectBoolean(TSex,'M','F',17,11);
  72.                6: TC := SelectSSN(TSSN,33,13);
  73.  
  74.                7: TC := SelectDate(TDate,58,3);
  75.                8: TC := SelectPhone(TPhone,58,5);
  76.                9: TC := SelectInteger(TInteger,0,32000,5,58,7);
  77.               10: TC := SelectReal(TReal,0,99.99,5,58,9);
  78.               11: TC := SelectBoolean(TYesNo,'Y','N',58,11);
  79.               12: NormalAtt  := ColorSelect(15,24, 2,16);
  80.               13: ReverseAtt := ColorSelect(15,60, 5,15);
  81.              End;
  82.              CheckLimit(LL,TC,Up,Down,1,13);
  83.            Until TC in Next;
  84.          End; { of Case = 1 }
  85.       2: Begin
  86.            For I := 1 to 8 Do ShowMultipleChoice(T1a,I,1,3);
  87.            For I := 1 to 6 Do ShowMultipleChoice(T1b,I,9,3);
  88.            LL := 1;
  89.            Repeat
  90.              Case LL Of
  91.                1 : TC := SelectMultiple(T1a,1,8,3,1);
  92.                2 : TC := SelectMultiple(T1b,1,6,3,9);
  93.              End;
  94.              CheckLimit(LL,TC,Up,Down,1,2);
  95.            Until TC in Next;
  96.          End;
  97.     End; { of case }
  98.   End;  { of With }
  99.   DisplayQuestion := TC;
  100. End;
  101.  
  102. Procedure AskQuestions(Var Test_Info : Test_Record);
  103. Const
  104.   Limit : Byte    = 2;
  105.   Up    : CharSet = [PageUp];
  106.   Down  : CharSet = [PageDown];
  107. Var
  108.   TC : Char;
  109.   I,J: Byte;
  110. Begin
  111.   I := 1;
  112.   With Test_Info do
  113.   Begin
  114.     TC := #0;
  115.     Repeat
  116.       MakeWindow(1,1,25,80,NormalAtt,NormalAtt,SingleBrdr,aWindow);
  117.       TitleWindow(Top,Left,' F1 = Help ');
  118.       TitleWindow(Top,Right,' ESC = QUIT ');
  119.       TitleWindow(Bottom,Left,' Data Entry Routines Version 1.2 ');
  120.       TitleWindow(Bottom,Right,' by: Juan M. Vegarra ');
  121.       Case I of
  122.         1 : Begin
  123.               For J := 3 To 15 Do QWrite(J,2,NormalAtt,Wind01[J]);
  124.               TC := DisplayQuestion(Test_Info, 1);
  125.             End;
  126.         2 : Begin
  127.               For J := 2 To 15 Do QWrite(J,2,NormalAtt,TISS[J]);
  128.               TC := DisplayQuestion(Test_Info, 2);
  129.             End;
  130.       End;
  131.       RemoveWindow;
  132.       CheckLimit(I,TC,Up,Down,1,Limit);
  133.     Until TC = Escape;
  134.   End;
  135. End;
  136.  
  137. Procedure InitialRoutine;
  138. Begin
  139.   CheckBreak := False;
  140.   CheckSnow := QSnow;
  141.   CheckCursor;
  142.   InitWindow(NormalAtt,True);
  143.   CursorOff;
  144.   Today(DefaultDate);
  145.   ExtKey := False;
  146.   FillChar(Test_Info, SizeOf(Test_Record), 0);
  147.   Test_Info.TDate := DefaultDate;
  148. End;
  149.  
  150. Begin
  151.   InitialRoutine;
  152.   AskQuestions(Test_Info);
  153.   CursorOn;
  154.   NormVideo;
  155.   ClrScr;
  156. End.
  157.